Delphi Programmer's Power Pack/Delphi Volume 1.iso/s_to_z/smtpmail/mmail.pas

Pascal/Delphi Source File | 1996-09-15 | 5.7 KB | 233 lines

unit Mmail;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Buttons, ExtCtrls, StdCtrls, Smtp,
  SMTPSu,IniFiles;

type
  TMailForm = class(TForm)
    ToolBar: TPanel;
    SendButton: TSpeedButton;
    SetupButton: TSpeedButton;
    ExitButton: TSpeedButton;
    SendInfoPanel: TPanel;
    ToEdit: TEdit;
    Label1: TLabel;
    Label3: TLabel;
    SubjectEdit: TEdit;
    CancelButton: TSpeedButton;
    AttachmentEdit: TEdit;
    Label2: TLabel;
    BodyMemo: TMemo;
    StatusBar: TPanel;
    AttachButton: TSpeedButton;
    procedure ExitButtonClick(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure SetupButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure AttachButtonClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    IniName : string;
    Mailer : TSMTP;
    procedure EnableControls;
    procedure DisableControls;
    procedure MailerStatusChange(Sender : TObject);
  public
    { Public declarations }
  end;

var
  MailForm: TMailForm;

implementation

{$R *.DFM}

procedure TMailForm.EnableControls;
var
  i : Integer;
  SB : TSpeedButton;
begin
  for i:=0 to ToolBar.ControlCount-1 do
  begin
    SB:=ToolBar.Controls[i] as TSpeedButton;
    SB.Enabled:=SB.Tag<>1;
  end;
  SendInfoPanel.Enabled:=true;
  BodyMemo.Enabled:=true;
  Cursor:=crDefault;
end;

procedure TMailForm.DisableControls;
var
  i : Integer;
  SB : TSpeedButton;
begin
  for i:=0 to ToolBar.ControlCount-1 do
  begin
    SB:=ToolBar.Controls[i] as TSpeedButton;
    SB.Enabled:=SB.Tag=1;
  end;
  SendInfoPanel.Enabled:=false;
  BodyMemo.Enabled:=false;
  Cursor:=crHourGlass;
end;

procedure TMailForm.ExitButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TMailForm.SendButtonClick(Sender: TObject);
begin
  if (Mailer.Server='') or (Mailer.From='') then
    MessageDlg('You might want to enter the information'^M^J+
               'in the Setup dialog box...',mtError,[mbOk],0)
  else
  if ToEdit.Text='' then
    MessageDlg('You might want to enter the recipient''s address first...'
               ,mtError,[mbOk],0)
  else
  with Mailer do
  begin
    Recipient:=ToEdit.Text;
    Subject:=SubjectEdit.Text;
    Body:=BodyMemo.Lines;
    Attachment:=AttachmentEdit.Text;
    try
      DisableControls;
      Connect;
      Send;
    finally
      Disconnect;
      EnableControls;
    end;
  end;
end;

procedure TMailForm.CancelButtonClick(Sender: TObject);
begin
  Mailer.Cancel;
end;

procedure TMailForm.SetupButtonClick(Sender: TObject);
var
  A,N : string;
begin
  with TSetupDlg.Create(Self) do
  try
    ServerEdit.Text:=Mailer.Server;
    Mailer.BreakLine(Mailer.From,A,N);
    UserAddressEdit.Text:=A;
    UserNameEdit.Text:=N;
    LogFileNameEdit.Text:=Mailer.LogFileName;
    EncodeComboBox.ItemIndex:=Ord(Mailer.Encoding);
    ShowModal;
    if ModalResult=mrOk then
    begin
      Mailer.Server:=ServerEdit.Text;
      Mailer.From:=UserAddressEdit.Text;
      Mailer.From:=Mailer.JoinLines(UserAddressEdit.Text,
                   UserNameEdit.Text);
      Mailer.LogFileName:=LogFileNameEdit.Text;
      Mailer.Encoding:=TEncoding(EncodeComboBox.ItemIndex);
    end;
  finally
    free;
  end;
end;

procedure TMailForm.MailerStatusChange(Sender : TObject);
var
  s : string;
begin
  case Mailer.Status of
   msIdle : s:='';
   msResolving : s:='Resolving remote host';
   msConnecting : s:='Connecting to server';
   msHeaders : s:='Sending headers';
   msEnvelope : s:='Sending commands';
   msBody : s:='Sending message body';
   msAttachment : s:='Sending attachment';
   msDisconnecting : s:='Disconnecting';
   msError : s:='Error';
   msCancel : s:='Canceled';
   msEnCode : s:='Encoding the attachment';
  end;
  StatusBar.Caption:=s;
end;

procedure TMailForm.FormCreate(Sender: TObject);
var
  A,N : string;
begin
  Mailer:=TSMTP.Create(Self);
  Mailer.OnStatusChange:=MailerStatusChange;
  IniName:=ChangeFileExt(Application.ExeName,'.ini');
  with TIniFile.Create(IniName) do
  try
    Mailer.Server:=ReadString('Setup','Server','');
    A:=ReadString('Setup','EMail Address','');
    N:=ReadString('Setup','Name','');
    Mailer.From:=Mailer.JoinLines(A,N);
    Mailer.LogFileName:=ReadString('Setup','Log File','');
    Mailer.Encoding:=TEncoding(ReadInteger('Setup','Encoding',0));
  finally
    free;
  end;
end;

procedure TMailForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  A,N : string;
begin
  with TIniFile.Create(IniName) do
  try
    WriteString('Setup','Server',Mailer.Server);
    Mailer.BreakLine(Mailer.From,A,N);
    WriteString('Setup','EMail Address',A);
    WriteString('Setup','Name',N);
    WriteString('Setup','Log File',Mailer.LogFileName);
    WriteInteger('Setup','Encoding',Ord(Mailer.Encoding));
  finally
    free;
    Mailer.Free;
  end;
end;

procedure TMailForm.AttachButtonClick(Sender: TObject);
begin
  with TOpenDialog.Create(Self) do
  try
    Filter:='All Files (*.*)|*.*';
    Options:=[ofHideReadOnly];
    if Execute then
    begin
      AttachmentEdit.Text:=FileName;
    end;
  finally
    Free;
  end;
end;

procedure TMailForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not SendInfoPanel.Enabled then
  begin
    MessageDlg('Transfer in Progress.  Click Cancel button first.',
               mtError,[mbOk],0);
    CanClose:=false;
  end
  else
    CanClose:=true;
end;

end.